home *** CD-ROM | disk | FTP | other *** search
/ Apple Developer Connection Student Program / ADC Tools Sampler CD Disk 3 1999.iso / Cool Demos, SDKs, & Tools / Demos⁄Tools⁄Offers / Alpha ƒ / Tcl / Packages / emacs.tcl < prev    next >
Text File  |  1999-04-14  |  6KB  |  260 lines
  1.  
  2. alpha::extension emacs 0.25 {
  3.     # To add a menu of emacs related actions to the Edit menu, click this box.||
  4.     # To remove the emacs menu from the Edit menu (once you've learnt all the
  5.     # shortcuts), click this box.
  6.     newPref f useEmacsMenu 1 global emacsToggle
  7.     # To make the capitalisation commands effect the previous word if the
  8.     # cursor is at its end, click this box.||To leave capitalisation commands
  9.     # unaltered, click this box.
  10.     newPref f emacLastWordIfTouching 0 global effectLastToggle
  11.     menu::buildProc emacs emacsBindings
  12.     emacsToggle
  13.     effectLastToggle
  14.     alpha::addToPreferencePage Packages emacLastWordIfTouching useEmacsMenu
  15. } help {file "Emacs Help"}
  16.  
  17.  
  18. proc effectLastToggle {args} {
  19.     global emacLastWordIfTouching
  20.     if {$emacLastWordIfTouching} {
  21.     if {[info command __upcaseWord] == ""} {
  22.         rename upcaseWord __upcaseWord
  23.         rename downcaseWord __downcaseWord
  24.         rename capitalizeWord __capitalizeWord
  25.     }
  26.     ;proc upcaseWord {} {
  27.         set p [getPos]
  28.         backwardWord
  29.         set sw [getPos]
  30.         forwardWord
  31.         set ew [getPos]
  32.         goto $p
  33.         if {[pos::compare $p == $ew]} {
  34.         backwardWord
  35.         __upcaseWord
  36.         } else {
  37.         __upcaseWord
  38.         }
  39.     }
  40.     ;proc downcaseWord {} {
  41.         set p [getPos]
  42.         backwardWord
  43.         set sw [getPos]
  44.         forwardWord
  45.         set ew [getPos]
  46.         goto $p
  47.         if {[pos::compare $p == $ew]} {
  48.         backwardWord
  49.         __downcaseWord
  50.         } else {
  51.         __downcaseWord
  52.         }
  53.     }
  54.     ;proc capitalizeWord {} {
  55.         set p [getPos]
  56.         backwardWord
  57.         set sw [getPos]
  58.         forwardWord
  59.         set ew [getPos]
  60.         goto $p
  61.         if {[pos::compare $p == $ew]} {
  62.         backwardWord
  63.         while {![regexp {\w} [lookAt [getPos]]]} {
  64.             forwardChar
  65.         }
  66.         __capitalizeWord
  67.         } else {
  68.         __capitalizeWord
  69.         }
  70.     }
  71.     unBind 'h' <z>    hiliteWord
  72.     Bind 'h' <z>    touchHiliteWord
  73.     } else {
  74.     if {[info command __upcaseWord] != ""} {
  75.         rename upcaseWord {}
  76.         rename downcaseWord {}
  77.         rename capitalizeWord {}
  78.         
  79.         rename __upcaseWord upcaseWord
  80.         rename __downcaseWord downcaseWord
  81.         rename __capitalizeWord capitalizeWord
  82.         unBind 'h' <z>    touchHiliteWord
  83.         Bind 'h' <z>    hiliteWord
  84.     }
  85.     }
  86. }
  87.  
  88. proc touchHiliteWord {} {
  89.     if {[pos::compare [getPos]==[selEnd]]} {
  90.     set p [getPos]
  91.     backwardWord
  92.     set sw [getPos]
  93.     forwardWord
  94.     set ew [getPos]
  95.     goto $p
  96.     if {[pos::compare $p == $ew]} {
  97.         select $sw $ew
  98.     } else {
  99.         forwardWord
  100.         set start [getPos]
  101.         backwardWord
  102.         select $start [getPos]
  103.     }
  104.     } else {
  105.     forwardChar
  106.     forwardWord
  107.     set start [getPos]
  108.     backwardWord
  109.     select $start [getPos]
  110.     }
  111. }
  112.  
  113. proc beginningOfLogicalLine {} {
  114.     beginningOfLine
  115.     set p [getPos]
  116.     set limit [pos::math [nextLineStart $p] - 1]
  117.     set llstart [search -f 1 -r 1 -n -l $limit {[^ \t\r\n]} $p]
  118.     if {$llstart != ""} {
  119.     goto [lindex $llstart 0]
  120.     }
  121. }
  122.  
  123. proc emacsToggle {args} {
  124.     global useEmacsMenu
  125.     if {$useEmacsMenu} {
  126.     menu::insert Edit submenu end emacs
  127.     hook::register requireOpenWindowsHook [list Edit emacs] 1
  128.     } else {
  129.     menu::removeFrom Edit submenu end emacs
  130.     hook::deregister requireOpenWindowsHook [list Edit emacs] 1
  131.     emacsBindings
  132.     }
  133. }
  134.  
  135. # Emacs-ish bindings.
  136. Bind 0x33 <e>      backwardDeleteWord
  137. Bind 'b' <es>    backwardWordSelect
  138. Bind '<' <se>     beginningOfBuffer
  139. Bind 'b' <X>    chooseWindowStatus
  140. Bind 'l' <X>    currentPosition
  141. Bind ')' <Xs>    endKeyboardMacro
  142. Bind '>' <se>     endOfBuffer
  143. Bind 'x' <Xz>    exchangePointAndMark
  144. Bind 'w' <Xz>    saveAs
  145. Bind 'e' <X>    executeKeyboardMacro
  146. Bind 'f' <Xz>    findFile
  147. Bind 'f' <es>     forwardWordSelect
  148. Bind 'c' <z>     prefixChar
  149. Bind 'x' <z>     prefixChar
  150. Bind 'r' <e>     repeatSearchBackward
  151. Bind 's' <e>     repeatSearchForward
  152. Bind 's' <Xz>    save
  153. Bind '(' <sX>    startKeyboardMacro
  154. Bind 'o' <X>    otherThing
  155. Bind '1' <X>    zoom
  156. Bind 'k' <X>    killWindowStatus
  157. Bind 'u' <X>    upcaseWord
  158.  
  159. Bind 'f' <e> forwardWord
  160. Bind 'b' <e> backwardWord
  161. Bind 'd' <e> deleteWord
  162. Bind 'h' <e> backwardDeleteWord
  163. Bind 'v' <e> pageBack
  164. Bind 'w' <e> copy
  165. Bind 'g' <e> gotoLine
  166. Bind 'e' <e> nextSentence
  167. Bind 'a' <e> prevSentence
  168. Bind 'c' <e> capitalizeWord
  169. Bind 'u' <e> upcaseWord
  170. Bind 'l' <e> downcaseWord
  171.  
  172. # added next -trf
  173. Bind 'm' <e> beginningOfLogicalLine
  174. Bind 'x' <e> execute
  175. Bind '\ '  <e> oneSpace
  176. Bind '\ '  <o> oneSpace
  177.  
  178. Bind 'd' <X>    killRegion
  179.  
  180. proc emacsBindings {} {
  181.     global useEmacsMenu
  182.     if {$useEmacsMenu} {
  183.     Menu -n emacs {
  184.         "/F<BforwardChar"
  185.         "/B<BbackwardChar"
  186.         "/D<BdeleteChar"
  187.         "/N<BnextLine"
  188.         "/P<BpreviousLine"
  189.         "(-"
  190.         "/F<IforwardWord"
  191.         "/B<IbackwardWord"
  192.         "/D<IdeleteWord"
  193.         "/v<IdeleteWord"
  194.         "/H<IbackwardDeleteWord"
  195.         "/u<IbackwardDeleteWord"
  196.         "(-"
  197.         "/K<BkillLine"
  198.         "/Y<Byank"
  199.         "/A<BbeginningOfLine"
  200.         "/E<BendOfLine"
  201.         "/O<BopenLine"
  202.         "(-"
  203.         "/V<BpageForward"
  204.         "/V<IpageBack"
  205.         "/L<BcenterRedraw"
  206.         "(-"
  207.         "/ <BsetMark"
  208.         "/W<Bcut"
  209.         "/W<Icopy"
  210.         "(-"
  211.         "/C<IcapitalizeWord"
  212.         "upcaseWord"
  213.         "/L<IdowncaseWord"
  214.         "(-"
  215.         "/X<Iexecute"
  216.         "/U<BiterationCount"
  217.         "/G<BabortEm"
  218.     }
  219.     } else {
  220.     Bind 'f' <z> forwardChar
  221.     Bind 'b' <z> backwardChar
  222.     Bind 'd' <z> deleteChar
  223.     Bind 'n' <z> nextLine
  224.     Bind 'p' <z> previousLine
  225.     Bind 'f' <o>  forwardWord
  226.     Bind 'b' <o>  backwardWord
  227.     Bind 'd' <o>  deleteWord
  228.     Bind 0x33 <so> deleteWord
  229.     Bind 'h' <o>  backwardDeleteWord
  230.     Bind 0x33 <o>  backwardDeleteWord
  231.     Bind 'k' <z> killLine
  232.     Bind 'y' <z> yank
  233.     Bind 'a' <z> beginningOfLine
  234.     Bind 'e' <z> endOfLine
  235.     Bind 'o' <z> openLine
  236.     Bind 'v' <z> pageForward
  237.     Bind 'v' <o> pageBack
  238.     Bind 'l' <z> centerRedraw
  239.     Bind '\ ' <z> setMark
  240.     Bind 'w' <z> cut
  241.     Bind 'w' <o> copy
  242.     Bind 'c' <o> capitalizeWord
  243.     Bind 'l' <o> downcaseWord
  244.     Bind 'x' <o> execute
  245.     Bind 'u' <z> iterationCount
  246.     Bind 'g' <z> abortEm
  247.     }
  248. }
  249.  
  250. proc killRegion {} {
  251.     set from [getMark]
  252.     set to [getPos]
  253.     if {[pos::compare $to < $from]} {
  254.     deleteText $to $from
  255.     } else {
  256.     deleteText $from $to
  257.     }
  258. }
  259.  
  260.